PROGRAM CHECKMEM

IMPLICIT NONE
INTEGER, PARAMETER :: EB = SELECTED_REAL_KIND(12)
INTEGER, PARAMETER :: MESSAGE_LENGTH=100, RARR_LENGTH=1000, N=500
INTEGER :: NITER,IZERO
INTEGER(KIND=8) :: TOT_REALS, TOT_GB
TYPE RARR_TYPE
    REAL(EB), ALLOCATABLE, DIMENSION(:,:,:) :: R
END TYPE
TYPE(RARR_TYPE), ALLOCATABLE, DIMENSION(:) :: RARRAY

ALLOCATE(RARRAY(RARR_LENGTH))
TOT_REALS = 0
DO NITER=1,RARR_LENGTH
    TOT_REALS = TOT_REALS + N**3
    TOT_GB    = TOT_REALS*8/1000000000 ! In GigaBytes
    WRITE(*,*) 'Trying to allocate iteration=',NITER,', TOT_GB=',TOT_GB,' GB.'
    ALLOCATE(RARRAY(NITER)%R(N,N,N),STAT=IZERO); RARRAY(NITER)%R = 1._EB
    WRITE(*,*) 'Size RARRAY(NITER)%R=',SIZE(RARRAY(NITER)%R,DIM=1),SIZE(RARRAY(NITER)%R,DIM=2),SIZE(RARRAY(NITER)%R,DIM=3)
    CALL ChkMemErr(NITER,TOT_REALS,IZERO)
ENDDO
PAUSE
DEALLOCATE(RARRAY)

CONTAINS

SUBROUTINE ChkMemErr(NITER,TOT_REALS,IZERO)
    INTEGER(KIND=8) :: TOT_REALS
    INTEGER NITER,IZERO
    CHARACTER(MESSAGE_LENGTH) MESSAGE
    IF (IZERO==0) RETURN
    WRITE(MESSAGE,'(A,I6,A,I10)') 'ERROR: Memory allocation failed for iter', NITER,' TOT_REALS ',TOT_REALS
    CALL SHUTDOWN(MESSAGE)
END SUBROUTINE ChkMemErr

SUBROUTINE SHUTDOWN(MESSAGE)
   CHARACTER(*) MESSAGE
   WRITE(*,'(/A/)') TRIM(MESSAGE)
   STOP
END SUBROUTINE SHUTDOWN

END PROGRAM CHECKMEM
